home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
program
/
rhtool2.zip
/
TVAPP.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-07-20
|
5KB
|
51 lines
{*
*
* Copyright (c) 1992,93 by Richard W. Hansen
*
* This source code will compile.
* Full source code available to registered users.
*
*}
(* This file was mangled by Mangler 1.10 (c) Copyright 1993 by Berend de Boer *)
UNIT TVAPP ;{$B+} {$X+} {$V-} {$I TVDEFS.INC} INTERFACE USES APP , DIALOGS , DRIVERS , OBJECTS , VIEWS ;
CONST CHELPCOLOR =#$37#$3F#$3A#$13#$13#$30#$3E#$1E;CHELPBLACKWHITE =#$07#$0F#$07#$70#$70#$07#$0F#$70;
CHELPMONOCHROME =#$07#$0F#$07#$70#$70#$07#$0F#$70;CCOLOR =#$CF#$7F#$70#$70#$70#$7F#$70#$78#$7E#$70#$7F+
#$7F#$70#$70#$07#$70#$70#$7F#$7F#$78#$70#$07#$7F#$70+ #$70#$7F#$70#$78#$0F#$07#$0F#$78#$70#$7F#$7E#$70;
CBLACKWHITE =#$8F#$7F#$70#$78#$70#$7F#$70#$78#$0F#$70#$7F+ #$7F#$70#$70#$07#$0F#$70#$07#$0F#$78#$70#$07#$7F#$70+
#$70#$7F#$70#$78#$0F#$07#$0F#$78#$70#$7F#$0F#$7F;CMONOCHROME =#$8F#$7F#$70#$78#$70#$7F#$70#$78#$0F#$70#$7F+
#$7F#$70#$70#$07#$0F#$70#$07#$0F#$78#$70#$07#$7F#$70+ #$70#$7F#$70#$78#$0F#$07#$0F#$78#$70#$7F#$0F#$7F;
CBUSYWINDOW =#136#136#136#136#136#136#136#136;TYPE PBXBUSYWINDOW =^TBXBUSYWINDOW ;
TBXBUSYWINDOW =OBJECT (TWINDOW)CONSTRUCTOR INIT (CONST AMESSAGE :STRING );FUNCTION GETPALETTE :PPALETTE ;VIRTUAL;
PROCEDURE SHOW ;VIRTUAL;END ;PBXAPPLICATION =^TBXAPPLICATION ;
TBXAPPLICATION =OBJECT (TAPPLICATION)MOUSEVISIBLE :BOOLEAN ;TOGGLEMOUSE :BOOLEAN ;CONSTRUCTOR INIT ;CONSTRUCTOR LOAD
(VAR S :TSTREAM );PROCEDURE CLOSEALLWINDOWS ;PROCEDURE GETEVENT (VAR EVENT :TEVENT );VIRTUAL;FUNCTION GETPALETTE
:PPALETTE ;VIRTUAL;PROCEDURE HANDLEEVENT (VAR EVENT :TEVENT );VIRTUAL;PROCEDURE HIDEBUSY ;PROCEDURE SETMOUSETOGGLE
(CONST ENABLE :BOOLEAN );PROCEDURE SHOWBUSY ;PROCEDURE STORE (VAR S :TSTREAM );END ;CONST BUSYWINDOW :PBXBUSYWINDOW =NIL
;PROCEDURE REGISTERTVAPP ;CONST RBXBUSYWINDOW :TSTREAMREC =(OBJTYPE :5200 ;VMTLINK :OFS (TYPEOF (TBXBUSYWINDOW )^);
LOAD :@ TBXBUSYWINDOW . LOAD ;STORE :@ TBXBUSYWINDOW . STORE );CONST RBXAPPLICATION :TSTREAMREC =(OBJTYPE :5201 ;
VMTLINK :OFS (TYPEOF (TBXAPPLICATION )^);LOAD :@ TBXAPPLICATION . LOAD ;STORE :@ TBXAPPLICATION . STORE );
IMPLEMENTATION CONSTRUCTOR TBXBUSYWINDOW.INIT (CONST AMESSAGE:STRING );VAR OO1I:TRECT;BEGIN OO1I.ASSIGN (0 , 0 , LENGTH
(AMESSAGE )+ 2 , 3 );INHERITED INIT(OO1I , '', WNNONUMBER );FLAGS := WFMOVE ;DRAGMODE := DMDRAGMOVE ;STATE := STATE AND
NOT SFVISIBLE ;GETEXTENT (OO1I );OO1I.GROW (- 1 , - 1 );INSERT (NEW (PSTATICTEXT , INIT (OO1I , AMESSAGE )));END ;
FUNCTION TBXBUSYWINDOW.GETPALETTE :PPALETTE ;CONST OO10:STRING [ LENGTH(CBUSYWINDOW)] =CBUSYWINDOW;BEGIN GETPALETTE := @
OO10 ;END ;PROCEDURE TBXBUSYWINDOW.SHOW ;BEGIN INHERITED SHOW;MAKEFIRST ;END ;CONSTRUCTOR TBXAPPLICATION.INIT ;
BEGIN INHERITED INIT;MOUSEVISIBLE := TRUE ;TOGGLEMOUSE := TRUE ;BUSYWINDOW := NEW (PBXBUSYWINDOW , INIT ('Working...'));
IF (BUSYWINDOW <> NIL )THEN DESKTOP ^. INSERT (BUSYWINDOW );END ;CONSTRUCTOR TBXAPPLICATION.LOAD (VAR S:TSTREAM);
BEGIN INHERITED LOAD(S );S.READ (MOUSEVISIBLE , SIZEOF (BOOLEAN ));S.READ (TOGGLEMOUSE , SIZEOF (BOOLEAN ));END ;
PROCEDURE TBXAPPLICATION.CLOSEALLWINDOWS ;PROCEDURE O1l0OIl1l101 (OO10:PVIEW);FAR ;BEGIN MESSAGE (OO10 , EVCOMMAND ,
CMCLOSE , NIL );END ;BEGIN DESKTOP ^. FOREACH (@ O1l0OIl1l101 );END ;PROCEDURE TBXAPPLICATION.GETEVENT
(VAR EVENT:TEVENT);BEGIN INHERITED GETEVENT(EVENT );IF TOGGLEMOUSE THEN CASE EVENT.WHAT OF EVMOUSEDOWN , EVMOUSEUP
:BEGIN IF NOT MOUSEVISIBLE THEN BEGIN MOUSEVISIBLE := TRUE ;SHOWMOUSE ;END ;END ;EVMOUSEMOVE :IF NOT MOUSEVISIBLE THEN
BEGIN MOUSEVISIBLE := TRUE ;SHOWMOUSE ;END ;EVKEYDOWN :IF MOUSEVISIBLE THEN BEGIN MOUSEVISIBLE := FALSE ;HIDEMOUSE ;
END ;END ;END ;FUNCTION TBXAPPLICATION.GETPALETTE :PPALETTE ;CONST OO10:ARRAY [ APCOLOR.. APMONOCHROME] OF STRING [
LENGTH(CAPPCOLOR+ CHELPCOLOR+ CCOLOR)] =(CAPPCOLOR+ CHELPCOLOR+ CCOLOR, CAPPBLACKWHITE+ CHELPBLACKWHITE+ CBLACKWHITE,
CAPPMONOCHROME+ CHELPMONOCHROME+ CMONOCHROME);BEGIN GETPALETTE := @ OO10 [ APPPALETTE ] ;END ;
PROCEDURE TBXAPPLICATION.HANDLEEVENT (VAR EVENT:TEVENT);BEGIN INHERITED HANDLEEVENT(EVENT );CASE EVENT.WHAT OF EVCOMMAND
:CASE EVENT.COMMAND OF CMCLOSEALL :BEGIN CLOSEALLWINDOWS ;CLEAREVENT (EVENT );END ;END ;END ;END ;
PROCEDURE TBXAPPLICATION.HIDEBUSY ;BEGIN IF (BUSYWINDOW <> NIL )THEN BUSYWINDOW ^. HIDE ;END ;
PROCEDURE TBXAPPLICATION.SETMOUSETOGGLE (CONST ENABLE:BOOLEAN);BEGIN IF (NOT ENABLE AND TOGGLEMOUSE )AND NOT MOUSEVISIBLE
THEN BEGIN MOUSEVISIBLE := TRUE ;SHOWMOUSE ;END ;TOGGLEMOUSE := ENABLE ;END ;PROCEDURE TBXAPPLICATION.SHOWBUSY ;BEGIN IF
(BUSYWINDOW <> NIL )THEN BUSYWINDOW ^. SHOW ;END ;PROCEDURE TBXAPPLICATION.STORE (VAR S:TSTREAM);BEGIN INHERITED STORE(S
);S.WRITE (MOUSEVISIBLE , SIZEOF (BOOLEAN ));S.WRITE (TOGGLEMOUSE , SIZEOF (BOOLEAN ));END ;PROCEDURE REGISTERTVAPP ;
BEGIN REGISTERTYPE (RBXBUSYWINDOW );REGISTERTYPE (RBXAPPLICATION );END ;END .